FAIRE DES CARTES DE FLUX DANS R
Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry’s standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum.
Les données
Jeu de données sur les migrations internationales. Migration Stock at subregional level, 2019 Source : United Nations, Department of Economic and Social Affairs, Population Division (2019). Voir
Les packages
install.packages("sf")
install.packages("remotes")
install.packages("smoothr")
library(remotes)
install_github("riatelab/mapsf")
install_github("tributetotobler/ttt")library("sf")
library("mapsf")
library("ttt")Import et mise en forme des données
Données géométriques
countries <- st_read("data/world/geom/countries.gpkg")
graticule <- st_read("data/world/geom/graticule.gpkg")
bbox <- st_read("data/world/geom/bbox.gpkg")
crs <-
"+proj=aeqd +lat_0=90 +lon_0=50 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs "
countries <- st_transform(x = countries, crs = crs)
graticule <- st_transform(x = graticule, crs = crs)
bbox <- st_transform(x = bbox, crs = crs)
land <- st_union(countries)Données attributaires
migr <- read.csv("data/world/fij/migr2019_T.csv")Template cartographique
col = "#ffc524"
credit = paste0(
"Françoise Bahoken & Nicolas Lambert, 2021\n",
"Source: United Nations, Department of Economic\n",
"and Social Affairs, Population Division (2019)"
)
# theme = mf_theme(x = "default", bg = "white", tab = FALSE,
# pos = "center", line = 2, inner = FALSE,
# fg = "#9F204270", mar = c(0,0, 2, 0),cex = 1.9)
theme <- mf_theme(
x = "default",
bg = "#3b3b3b",
fg = "#ffc524",
mar = c(0, 0, 2, 0),
tab = TRUE,
pos = "left",
inner = FALSE,
line = 2,
cex = 1.9,
font = 3
)
template = function(title, file) {
mf_export(
countries,
export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0, -.02, 0)
)
mf_map(
bbox,
col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)
mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
countries,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
# mf_map(links, col = NA,border = "#317691", lwd = 0.5, add = TRUE)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_title(title)
}template("Template cartographique", "maps/template.png")
dev.off()Ce qu’on peut faire en R base & mapsf
L’effet Spaghetti
links <-
mf_get_links(
x = countries,
df = migr,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)template("L'effet Spaghetti ", "maps/spaghetti.png")
mf_map(links, col = col, add = TRUE)
mf_map(land,
col = NA,
border = "#3b3b3b",
add = TRUE)
dev.off()Sélectionner un seul pays
Choix d’un pays
ISO3 <- "FRA"
label = "France"Jointure et mise en forme des données
countr <- countries[, c("adm0_a3_is", "label")]
migrFRA <- migr[migr$j == ISO3, ]
migrFRA$fij <- as.numeric(migrFRA$fij)
maxval = max(migrFRA$fij)
total = round(sum(migrFRA$fij) / 1000000,1)
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)
countr <- countr[-3]
colnames(countr) <- c("id", "label", "fij", "geometry")knitr::kable(countr[c(0:10),], row.names = F, digits = 1)| id | label | fij | geometry |
|---|---|---|---|
| ABW | Aruba | 11 | MULTIPOLYGON (((-7476945 42… |
| AFG | Afghanistan | 6887 | MULTIPOLYGON (((2474775 -53… |
| AGO | Angola | 23438 | MULTIPOLYGON (((-4917506 -1… |
| AIA | Anguilla | 10 | MULTIPOLYGON (((-7351488 31… |
| ALB | Albania | 7371 | MULTIPOLYGON (((-2639654 -4… |
| AND | Andorra | 1079 | MULTIPOLYGON (((-3952645 -3… |
| ARE | United Arab Emirates | 862 | MULTIPOLYGON (((785851 -712… |
| ARG | Argentina | 14253 | MULTIPOLYGON (((-14113355 7… |
| ARM | Armenia | 21012 | MULTIPOLYGON (((-348529.3 -… |
| ASM | American Samoa | 1 | MULTIPOLYGON (((7561304 878… |
Une première carte simple
template(paste0("En 2019, il y avait ",total, " millions d'étrangers en France"),
"maps/prop1.png")
#mf_map(countr[countr$id == ISO3,], col = col, border = "red", lwd = 2, add = TRUE)
mf_map(
countr[countr$id != ISO3, ],
var = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countr[countr$id == ISO3, ],
col = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)
dev.off()La carte symétrique
countr <- countries[, c("adm0_a3_is", "label")]
migrFRA <- migr[migr$i == ISO3, ]
migrFRA$fij <- as.numeric(migrFRA$fij)
total = round(sum(migrFRA$fij) / 1000000,1)
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j",
all.x = TRUE
)
countr <- countr[-3]
colnames(countr) <- c("id", "label", "fij", "geometry")template(paste0("En 2019, il y avait ",total, " millions de Français à l'étranger"),
"maps/prop2.png")
mf_map(
countr[countr$id != ISO3, ],
var = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countr[countr$id == ISO3, ],
col = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)
dev.off()On peut faire la même carte en faisant varier l’épaisseur des liens
ISO3 <- "FRA"
label = "France"
migrtoFRA <- migr[migr$j == ISO3,]
migrtoFRA$fij <- as.numeric(migrtoFRA$fij)links <-
mf_get_links(
x = countries,
df = migrtoFRA,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)template(
paste0("Origine des personnes migrantes vivant en ", label, " en 2019"),
"maps/links1.png"
)
mf_map(
links,
var = "fij",
col = col,
border = "white",
type = "prop",
inches = 10,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countries[countries$adm0_a3_is == ISO3,],
col = "#4e4f4f",
border = col,
lwd = 1.5,
add = TRUE
)
dev.off()Une carte un peu plus sophistiquée avec packcircles
ISO3 <- "FRA"
label = "France"
migrFRA <- migr[migr$j == ISO3,]
migrFRA$fij <- as.numeric(migrFRA$fij)
migrFRA <-
rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))
countr <- countries[, "adm0_a3_is"]
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)
colnames(countr) <- c("i", "j", "fij", "geometry")knitr::kable(countr[c(0:10),], row.names = F, digits = 1)| i | j | fij | geometry |
|---|---|---|---|
| ABW | FRA | 11 | MULTIPOLYGON (((-7476945 42… |
| AFG | FRA | 6887 | MULTIPOLYGON (((2474775 -53… |
| AGO | FRA | 23438 | MULTIPOLYGON (((-4917506 -1… |
| AIA | FRA | 10 | MULTIPOLYGON (((-7351488 31… |
| ALB | FRA | 7371 | MULTIPOLYGON (((-2639654 -4… |
| AND | FRA | 1079 | MULTIPOLYGON (((-3952645 -3… |
| ARE | FRA | 862 | MULTIPOLYGON (((785851 -712… |
| ARG | FRA | 14253 | MULTIPOLYGON (((-14113355 7… |
| ARM | FRA | 21012 | MULTIPOLYGON (((-348529.3 -… |
| ASM | FRA | 1 | MULTIPOLYGON (((7561304 878… |
Cercles avec packcircles (Dorling style)
library(packcircles)dots = countr
st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
dots <- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
colnames(dots) <- c("id", "x", "y", "v")
dots <- dots[!is.na(dots$v), ]
k = 700000 # pour ajuster la taille des cercles
itermax = 10 # nombre d'iterations
delta = 35000
dat.init <- dots[, c("x", "y", "v", "id")]
dat.init$v <- sqrt(as.numeric(dat.init$v) * k)
simulation <- circleRepelLayout(
x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
)$layout
circles <- st_buffer(sf::st_as_sf(
simulation,
coords = c('x', 'y'),
crs = sf::st_crs(countries)
),
dist = simulation$radius - delta)
circles$v = dots$v
circles$id = dots$idLinks
# Links
dots$j = "FRA"
links <-
mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)
links$fij = as.numeric(links$fij)Réalisation de la carte
template("Les étrangers en France, 2019", "maps/migrexplorer1.png")
col2 = "#4e4f4f"
mf_map(
land,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,
var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
circles[circles$id != ISO3, ],
var = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
circles[circles$id == ISO3, ],
var = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
t = circles[circles$id != ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
t = circles[circles$id == ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Comme précédemment, on peut faire la carte en symétrie en inversant i et j.
ISO3 <- "FRA"
label = "France"
migrFRA <- migr[migr$i == ISO3,] # ici
migrFRA$fij <- as.numeric(migrFRA$fij)
migrFRA <-
rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))
countr <- countries[, "adm0_a3_is"]
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j", # là
all.x = TRUE
)
colnames(countr) <- c("i", "j", "fij", "geometry")dots = countr
st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
dots <- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
colnames(dots) <- c("id", "x", "y", "v")
dots <- dots[!is.na(dots$v), ]
k = 700000 # pour ajuster la taille des cercles
itermax = 10 # nombre d'iterations
delta = 35000
dat.init <- dots[, c("x", "y", "v", "id")]
dat.init$v <- sqrt(as.numeric(dat.init$v) * k)
simulation <- circleRepelLayout(
x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
)$layout
circles <- st_buffer(sf::st_as_sf(
simulation,
coords = c('x', 'y'),
crs = sf::st_crs(countries)
),
dist = simulation$radius - delta)
circles$v = dots$v
circles$id = dots$idLinks
# Links
dots$j = "FRA"
links <-
mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)
links$fij = as.numeric(links$fij)Réalisation de la carte
template("Les français à l'étranger, 2019", "maps/migrexplorer2.png")
col2 = "#4e4f4f"
mf_map(
land,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,
var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
circles[circles$id != ISO3, ],
var = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
circles[circles$id == ISO3, ],
var = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
t = circles[circles$id != ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
t = circles[circles$id == ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Ces cartes, on peut les retrouver dans l’application MigrExplorer mise en ligne via R shiny.
https://gitlab.huma-num.fr/nlambert/migrexplorer/-/tree/master
Changer de maillage
Contrairement aux cartes pays * pays, cartographier les flux au niveau régional permet de mieux percevoir la logique des mobilités internationales. Cette carte, pas très élégantes, a été réalisée et présentée par François Héron pour ses cours au Collège de France.
Et si on esseyait de la reproduire en R ?
migr <- read.csv("data/world/subregions/migrantstocks2019.csv")
subregions <- st_read("data/world/geom/subregions.gpkg") %>% st_transform(crs)template("Subregions", "maps/subregions.png")
mf_map(
subregions,
col = "#4e4f4f",
border = col,
lwd = 0.5,
add = TRUE
)
mf_label(
x = subregions,
var = "label",
halo = TRUE,
bg = "#4e4f4f",
cex = 0.8,
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Flowmapper
flowmapper() est une fonction du package ttt (en cours de développement).
library(ttt)La fonction ttt_flowmapper() prends plusieurs arguements :
…
Les données
migr <- read.csv("data/world/subregions/migrantstocks2019.csv")
threshold <- 1500
migr <- migr[migr$fij >= threshold, ]knitr::kable(migr[c(0:10),], row.names = F, digits = 1)| i | j | fij |
|---|---|---|
| 5500 | 923 | 5603 |
| 5501 | 5501 | 11177 |
| 5501 | 918 | 5334 |
| 5501 | 920 | 1666 |
| 5501 | 922 | 18402 |
| 5501 | 924 | 2551 |
| 906 | 906 | 5202 |
| 906 | 918 | 5700 |
| 910 | 910 | 5330 |
| 910 | 913 | 1538 |
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
plot = FALSE
)Liens
template("ttt_flowmapper$links", "maps/ttt_links.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$links,
col = col,
lwd = 3,
add = TRUE)
dev.off()Cercles
template("ttt_flowmapper$circles", "maps/ttt_circles.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$circles, col = col, add = TRUE)
dev.off()Flêches
template("ttt_flowmapper$flows", "maps/ttt_flows.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$flows, col = col, add = TRUE)
dev.off()Visualisation par défaut
template("flowmappze", "maps/ttt_flows.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
ttt_flowmapperlegend(x = flows, title = "Flux", col = col)
dev.off()La VV taille, c’est aussi la surface
template("La surface des fleches", "maps/ttt_surface.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
size = "area",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
dev.off()Epaisseur vs Surface
Interactions (type = “rect”)
migr2 <- data.frame(i = integer(), j = integer(), fij = integer())
for (k in 1:length(migr$i)) {
val1 <- migr$fij[k]
val2 <- migr[migr$i == migr$j[k] & migr$j == migr$i[k], "fij"]
val <- sum(val1, val2)
idi = migr$i[k]
idj = migr$j[k]
test <-
length(migr2[(migr2$i == idi &
migr2$j == idj) | (migr2$i == idj & migr2$j == idi), "fij"])
if (test == 0) {
migr2 <- rbind(migr2, data.frame(i = idi, j = idj, fij = val))
}
}
migr2 <- migr2[migr2$i != migr2$j, ] head(migr2)## i j fij
## 1 5500 923 9999
## 3 5501 918 5334
## 4 5501 920 3221
## 5 5501 922 18402
## 6 5501 924 2551
## 8 906 918 5700
template("tInteractions", "maps/ttt_interactions.png")
c <- ttt_flowmapper(
x = subregions,
xid = "id",
size = "thickness",
type = "rect",
df = migr2,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
dev.off()Combiner flux intra et flux inter
intra <- migr[migr$i == migr$j, ]
intra <- intra[, c("i", "fij")]
colnames(intra) <- c("id", "nb")
knitr::kable(intra, row.names = F, digits = 1)template("Flux inter et flux intra", "maps/interintra.png")
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = col,
border = "#424242",
k = NULL,
k2 = 60,
df2 = intra,
df2id = "id",
df2var = "nb",
col2 = "#eb4034",
border2 = "#424242"
)
dev.off()Reprojection
1 - calcul en projection polaire
tmp <- ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = "#ffc524",
border = "#424242",
border2 = "#ffc524",
plot = FALSE
)2 - reprojection & nouveau template
crs <-
"+proj=ortho +lat_0=42.5333333333 +lon_0=-72.53333333339999 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"
flows <- smoothr::densify(tmp$flows, n = 30) %>% st_transform(crs)
dots <- st_transform(tmp$circles, crs)
subregions <- st_transform(subregions, crs)
graticule <- st_transform(graticule, crs)
bbox <- st_transform(bbox, crs)3 - affichage
title = "Flux sur Globe"
file = "maps/ttt_globe.png"
mf_export(
subregions,
export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0,-.02, 0)
)
mf_map(
bbox,
col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)
mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_map(flows, col = col, add = TRUE)
mf_map(dots, col = col, add = TRUE)
mf_title(title)
dev.off()Visualiser R/Shiny
https://gitlab.huma-num.fr/nlambert/migrexplorer3/-/tree/master